Imports System.Data.OleDb

''' <summary>
''' Access
''' </summary>
''' <remarks>
''' Requires installation of MS Jet engine; this is almost always already done, but if not, run MDAC_TYP.EXE installer in Redist folder
''' </remarks>
Public Class clsDBAccess
    Inherits clsDBOleDB

    ''' <summary>
    ''' Return a copy of the current generic connection
    ''' </summary>
    ''' <returns>Clone of current instance</returns>
    Public Overrides Function Clone() As clsDB
        Dim db As clsDB = New clsDBAccess
        MyBase.CloneSelf(db)
        Return db
    End Function

    ''' <summary>
    ''' Creates a provider-specific connection object given previously specified properties as required (DataSource, DatabaseName, UserName, Password, etc.)
    ''' Note that the connection is normally automatically created when you instantiate the class
    ''' </summary>
    Public Overrides Sub CreateConnection()
        Dim csb As New OleDbConnectionStringBuilder
        With csb
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .DataSource = DataSource
            If Not String.IsNullOrEmpty(Password) Then .Add("Jet OLEDB:Database Password", Password)
            Connection = New OleDbConnection(.ConnectionString)
        End With
    End Sub

    ''' <summary>
    ''' Creates new database on the provider (uses supervisor access)
    ''' </summary>
    ''' <param name="DatabaseName">Desired name of new database</param>
    ''' <returns>True if successful</returns>
    Public Overrides Function CreateDatabase(ByRef DatabaseName As String) As Boolean
        Try
            Dim cat As New ADOX.Catalog
            cat.Create(ADOXConnectionString)
            Return True

        Catch ex As Exception
            Return False
        End Try
    End Function

    ''' <summary>
    ''' ADOX requires a connection string compatible with OLEDB: provide one
    ''' </summary>
    ''' <returns>ADOX connection string</returns>
    Private ReadOnly Property ADOXConnectionString() As String
        Get
            Dim prefix As String
            Select Case DatabaseType
                Case enumDBType.Paradox To enumDBType.Access : prefix = ""
                Case enumDBType.SQL_Server : prefix = "Provider=SQLOLEDB;"
                Case enumDBType.Oracle : prefix = "Provider=MSDAORA;"
                Case Else
                    prefix = ""
            End Select
            Return prefix & Connection.ConnectionString
        End Get
    End Property

    ''' <summary>
    ''' Perform database compaction/repair operation where supported
    ''' </summary>
    Public Overrides Sub RepairDatabase(Optional ByVal Interactive As Boolean = False)
        Dim jro As New JRO.JetEngine
        With My.Computer.FileSystem
            Dim NewName As String = DataSource.ToLower.Replace(".mdb", "-backup.mdb")
            If .FileExists(NewName) Then .DeleteFile(NewName)
            .RenameFile(DataSource, IO.Path.GetFileName(NewName))
            Try
                jro.CompactDatabase(Connection.ConnectionString.Replace(".mdb", "-backup.mdb"), Connection.ConnectionString & ";Jet OLEDB:Engine Type=5")
            Catch ex As Exception
                Try
                    .RenameFile(NewName, IO.Path.GetFileName(DataSource))
                Catch ex2 As Exception
                End Try
                Throw
            Finally
                If My.Computer.FileSystem.FileExists(NewName) Then My.Computer.FileSystem.DeleteFile(NewName)
            End Try
        End With
    End Sub

    ''' <summary>
    ''' Rename table in current project
    ''' </summary>
    ''' <param name="OldName">Name of existing table (must already exist)</param>
    ''' <param name="NewName">New name for table (must not already exist)</param>
    ''' <returns>True if successful</returns>
    ''' <remarks>This is the only place in this project that references the old Microsoft ActiveX Data Object and ADOX libraries</remarks>
    Public Overrides Function RenameTable(ByVal OldName As String, ByVal NewName As String, Optional ByVal dtTemplate As DataTable = Nothing) As Boolean
        If TableExists(New String() {NewName, OldName}) Then Return False
        Dim cn As New ADODB.Connection
        cn.Open(Me.ADOXConnectionString)
        Try
            Dim cat As New ADOX.Catalog
            cat.ActiveConnection = cn
            cat.Tables(RemoveBrackets(OldName)).Name = NewName
            Return True
        Catch ex As Exception
            Throw
            Return False
        Finally
            cn.Close()
            cn = Nothing
        End Try
    End Function

    Public Overrides Function GetTableList() As System.Collections.Generic.List(Of String)
        Return MyBase.GetTableList

        'following worked, but was no faster so why bother?

        'Dim lst As New Generic.List(Of String)
        'Dim cn As New ADODB.Connection
        'cn.Open(Me.ADOXConnectionString)
        'Try
        '    Dim cat As New ADOX.Catalog
        '    cat.ActiveConnection = cn
        '    For Each tbl As ADOX.Table In cat.Tables
        '        lst.Add(RemoveBrackets(Proper(tbl.Name)))
        '    Next
        '    Return lst
        'Catch ex As Exception
        '    Throw
        '    Return lst
        'Finally
        '    cn.Close()
        '    cn = Nothing
        'End Try
    End Function

    Public Overrides Function GetViewList() As System.Collections.Generic.List(Of String)
        Return MyBase.GetViewList

        ''following worked, but was no faster so why bother?

        'Dim lst As New Generic.List(Of String)
        'Dim cn As New ADODB.Connection
        'cn.Open(Me.ADOXConnectionString)
        'Try
        '    Dim cat As New ADOX.Catalog
        '    cat.ActiveConnection = cn
        '    For Each view As ADOX.View In cat.Views
        '        lst.Add(RemoveBrackets(Proper(view.Name)))
        '    Next
        '    Return lst
        'Catch ex As Exception
        '    Throw
        '    Return lst
        'Finally
        '    cn.Close()
        '    cn = Nothing
        'End Try
    End Function

End Class
